perm filename JSX[NEW,LCS] blob sn#701991 filedate 1983-03-10 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C 2/18/83  ******** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
C00024 ENDMK
CāŠ—;
C 2/18/83  ******** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
	SUBROUTINE JUSTFY(JLP,ITEM,NPW,NO,RN,RSTFAC,R2,R4,R5)
CX	SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
COPYRIGHT 1983 BY LELAND SMITH
	COMMON/RINP/XPS(900),XPR(300)
	COMMON /JST/ N,XP(300),XPL(300)
	DIMENSION RN(1),NO(1),RSTFAC(0/1),NPW(1)
C JLP= TOP STAFF NUM.
C R2=THIS STAFF NUM.  R4=LEFT EDGE, R5=RIGHT EDGE.

	RJLP=JLP
	N=1
	DO 200 K=1,ITEM
	L=NPW(K)
	RL=RN(L)
C  RL=WDCNT-2
	RA=RN(L+1)
C  RA=CODE NUM.
	RR3=RN(L+3)
C  RR3=POSITION(P3)
	IF(RR3+0.1.LT.R4.OR.RR3.GT.R5)GO TO 200
C JUMP IF ITEM NOT IN BOUNDS
	IF(RA.GT.4.0.AND.RA.LT.17.0)GO TO 200
C LOOKS AT NOTES, RESTS, CLEFS, BARS, KSIG, METER
	RR2=RN(L+2)
C  RR2=STAFF NUM. OF THIS ITEM
	IF(RR2.NE.R2.AND.R2.LE.RJLP)GO TO 200
C  THIS STAFF? OR LOOK AT ALL STAVES.
	RY=1.
C BASIC SIZE FACTOR
	PL=0
	RR5=RN(L+5)
C  RR5=PARAM 5    RR6=P6   RW=P4 
	RR6=RN(L+6)
78	RR4=RN(L+4)
C  RR4=HEIGHT-MINI(P4)
	M=RA
	GO TO(1,2,3,4)M     
C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.

	IF(M.EQ.18)GO TO 18
	GO TO 17

C***** NOTES ******
1	IF(RL.GE.7.0.AND.RN(L+9).LT.0)GO TO 200
C  IF P9<0 IGNORE THIS NOTE.
	RR7=RN(L+7)
C RR7=P7  DOTS, TAILS
	RC=ABS(RR4)
	RR4=AMOD(RR4,100.0)
	IF(RR4.GT.80.0)RR4=RR4-100.0
	IF(RC.LT.80.)GO TO 19
	IF(RC.LT.180.)RY=.6
C  FOUND A MINI-NOTE

CC19	PL=1.
C SPACE NEEDED TO LEFT
19	PR=3.5
C SPACE NEEDED TO RIGHT
	PRR=0
C STORES EXTRA SPACE TO RIGHT
	PLL=0
C STORES EXTRA SPACE TO LFT
	
CX	IF(RR4.LT.13.0.AND.RR4.GT.1.0)GO TO 10
C IF LEDGER LINES ADD SPACE ON BOTH SIDES.
CX	PR=4.0
CX	PL=1.0
10	IF(RR7.EQ.0)GO TO 12
C TAIL ON NOTE?  (CHECK FOR HALF, WHOLE NOTES, RR6<0)
	RR=AMOD(RR7,10.0)
	IF(RR.LE.0.OR.RR6.LT.0)GO TO 11
	IF(RR5.LT.10.0.OR.RR5.GE.20.0)GO TO 11
C SKIP IF NO STEM OR STEM DOWN
	PRR=1.5
C ADD ROOM FOR TAIL
	
11	KK=RR7/10
CC	PX=2*KK
	PX=1.6*KK
C SPACE FOR DOT(S)
	PX=PX+AMOD(RR7,1.0)*10.0
C ADD SOME IF DOTS SPACED EXTRA TO RIGHT (E.G. 1.23=2.3 SPACES TO RT.)
	IF(PX.GT.PRR)PRR=PX
	IF(RR7.GE.10.0)GO TO 1012
C NOTE HAS DOT, NO SPACE NEEDED FOR LEDGER LINE.
	IF(RR5.GE.10.0.AND.RR5.LT.20.0.AND.AMOD(RR7,10.0).GE.1.0)
	1 GO TO 1012
C SKIP IF NOTE HAS TAIL ON STEM UP.
12	 IF(PRR.GT.1.5)GO TO 1012
C ALREADY ENOUGH SPACE FOR LEDGER LINE EXTENSION - SKIP NEXT
	JJ=0
C NOW FIND NEXT CLOSEST NOTE TO RIGHT ON THIS STAFF.
	Z=10.0
	X=RR4-13.0
	DO 1000 M=1,ITEM
	J=NPW(M)
	IF(RN(J+1).NE.1.0)GO TO 1000
C LOOK AT NOTES ONLY
	IF(RN(J+2).NE.RR2)GO TO 1000
C THIS STAFF ONLY
	Y=RN(J+3)-RR3
	IF(Y.LE.0.OR.Y.GT.Z)GO TO 1000
	Z=Y
	JJ=J
1000	CONTINUE
	IF(Z.GE.10.0)GO TO 1012
	IF(AMOD(RN(JJ+5),10.0).GE.1.0)GO TO 1012
C SKIP IF NEXT NOTE HAS ACCI. IN FRONT.
	Z=AMOD(RN(JJ+4),100.0)
C GET HEIGHT OF NOTE
	IF(X.GE.0)GO TO 1001
C SKIP IF 1ST NOTE IS ABOVE STAFF 
	IF(Z.GE.1.0)GO TO 1002
	GO TO 1012
1001	IF(Z.LT.13.0)GO TO 1012
C SKIP IF NEXT NOTE BELOW STAFF
1002	PRR=1.5
C ADD 1. SO LEDGER LINES DON'T BUMP

1012	RR=AMOD(RR5,10.0)
C ANY ACCIDENTALS?
	IF(RR.EQ.0)GO TO 13
	PLL=3.0
	IF(IFIX(RR).EQ.4)PLL=5.0
C RR=4 = DOUBLE FLAT
	PLL=PLL+AMOD(RR5,1.0)*10.0
C INCREASE IF ACCI. SPACED TO LEFT. (E.G. 12.21 =2.1 SPACES TO LEFT)

13	IF(RR6.EQ.0)GO TO 14
C LOOK FOR HALF NOTES, WHOLE NOTES, NOTES ON WRONG SIDE OF STEM.
	KK=0
	IF(RR6.GT.0)GO TO 130
C NOW IT'S A WHITE NOTE
	PR=3.9
C 3.9=MINIMUM SPACE FOR HALFNOTE
	KK=IFIX(AMOD(RR7,10.0))
C GET RT. DIGIT IN P7
	IF(KK.EQ.1)PR=4.3
	IF(KK.EQ.2)PR=4.8
C =1=WHOLENOTE, =2=DOUBLE WHOLENOTE
	IF(RR6.GT.-10.0)GO TO 14
C NOW NOTE ON WRONG SIDE OF STEM
130	AR=2.5
	IF(KK.EQ.1)AR=3.0
	IF(KK.EQ.2)AR=3.5
	IF(ABS(RR6).GE.20.0)GO TO 135
C NOW NOTE TO RIGHT OF STEM
	PRR=PRR+AR
	GO TO 14
135	PLL=PLL+AR
C ADD SPACE TO LEFT IF NOTE ON LEFT SIDE OF STEM

14    	PR=(PR+PRR)*RY
	PL=(PL+PLL)*RY
	
	IF(RL.LT.8)GO TO 700
C JUMP IF THERE IS NOT P10 TO LOOK AT
	RR2=RR2+1
CC	RW=RN(L+10)
C PUT P10 INTO RW
	IF(RN(L+10).GE.2.0)RR2=RR2-2.
C NOW STAFF # IS SET TO WHERE NOTE REALLY IS.
	GO TO 700

C***** RESTS *****
2	IF(RL.GE.4.0.AND.RR6.LT.0)GO TO 200
	IF(RL.GE.5.0.AND.RR7.LT.0)GO TO 200
C SKIP INVISIBILE RESTS AND RESTS WITH NEG. RHY.
	IF(RL.GE.6.0.AND.RR8.NE.0)GO TO 200
C RR8<0=CENTERED WHOLE REST - ASSUMES NO NEED TO JUSTIFY.
	PR=3.0
	IF(RL.GE.5.0)PR=PR+RR6*2.0
C RR6=DOTS
CC	PL=1.0
	GO TO 700
	
3	IF(RL.LT.3)GO TO 30
C  <3 MEANS NOTHING IN R5
	IF(RR5.GT.4)GO TO 200
C  NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
30	IF(RL.GE.2.AND.RR4.GE.100.0)RY=.85
	PR=6.5*RY
	GO TO 700

4	IF(RL.GT.3.OR.RR4.LT.0)GO TO 200
C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
	PL=0.5
	PR=1.
C PL=SPACE NEEDED TO LEFT, PR=SPACE NEEDED TO RIGHT, RR3=POS. OF ITEM
	KX=RR4/1000.
	IF(KX.LE.0.)GO TO 40
	PL=3.2
C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
	IF(KX.EQ.2.OR.KX.EQ.4)PR=6.0
C KX=2=DOTS TO RIGHT
	IF(KX.GT.2)PL=4.2
C KX>2=DOTS TO LEFT
CC	IF(RL.LT.3)GO TO 700
C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN R5.
CC229	IF(KX.NE.2)PR=PR+PR
C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
CC	PL=-PL/RBX
CC	IF(KX.EQ.4)KX=0
CC129	IF(KX.GE.2)PL=RBZ*PL
C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
	GO TO 42
40	Z=999.
C FIND NEXT CLOSEST ITEM.
	DO 41 M=1,ITEM
	J=NPW(M)
	IF(R2.LE.RJLP.AND.R2.NE.RN(J+2))GO TO 41
C SKIP IF NOT ON RIGHT STAFF
	X=RN(J+3)
	IF(X.GT.Z.OR.X.LE.RR3)GO TO 41
	Z=RR3
	L=J
C SAVE POS. AND CODE NUM.
41	CONTINUE
	IF(RN(L+1).LE.2.0)PR=PR+1.5
C IF A NOTE OR REST, ADD 1.5 TO SPACE

42	RR4=AMOD(RR4,100.0)
C FIND HOW MANY STAVES UP THE BAR GOES
	IF(RR4.EQ.0)RR4=1.0
	RR4=RR4+RR2
43	CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C    RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
	RR2=RR2+1.0
C RESERVE SPACE FOR BAR LINE ON EVERY STAFF COVERED.
	IF(RR2.LT.RR4)GO TO 43
	GO TO 200

C KSIG  
17	RR5=ABS(RR5)
	IF(RR5.GE.100)RR5=RR5-100
C  +100 FOR NATURALS AS KEYSIG.
	PR=0.5+2.1*(RR5-1)
C  SPACES FOR CORRECT NUM OF ACCIS.  RR5=NUM OF ACCIS.
	PL=3.0
	GO TO 700

C METER
18	RC=0
	IF(RL.GE.7)RC=9
C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
	PR=4.0
	PL=1.5
	IF(RR6.LE.9.AND.RR5.LE.9)GO TO 180
C  CHECKS FOR 2-DIGIT METERS
	PR=6.0
	PL=2.5
180	PR=PR+RC
700	CALL ROOM(RR3,PL,PR,RR2,R4,R5,RSTFAC)
C    RR3=POS.,PL=NEED TO LEFT,PR=NEED TO RIGHT, RR2=STAFF#
200	CONTINUE
	CALL JSORT(NO,R2,R4,R5,RN)
300	END

	SUBROUTINE ROOM(RB,RL,RR,STAF,R4,R5,RSTFAC)
C SETS UP ARRAYS CONTAINING ALL NEEDED SPACE INFO
	COMMON /RINP/PS(900),PR(300)
	COMMON /JST/ N,P(300),PL(300)
C SHARE THESE ARRAYS WITH SOME OTHERS??? (RINP?)
	DIMENSION RSTFAC(0/1)
	P(N)=0
	PL(N)=0
	PR(N)=0
	PS(N)=-1
C ZERO OUT NEXT ARRAY SLOTS
	IF(ABS(RB-R4).LE.0.1)RL=0
	IF(ABS(RB-R5).LE.0.1)RR=0
CHECK TO SEE IF ITEM IS AT LEFT OR RIGHT EDGE OF JUSTIFY AREA.
	K=STAF
	S=RSTFAC(K)
C GET PROPER SIZE FACTOR FOR THIS STAFF
	RL=RL*S
	RR=RR*S
	DO 1 K=1,N-1
	IF(ABS(RB-P(K)).GT.0.1)GO TO 1
C SAME POSITION?
	IF(RB.LT.P(K))P(K)=RB
C USE POSITION FARTHEST TO LEFT
	IF(STAF.NE.PS(K))GO TO 1
C SAME STAFF?
	IF(PR(K).LT.RR)PR(K)=RR
	IF(PL(K).LT.RL)PL(K)=RL
C ITEM IN SAME POS.  CHANGE SPACE REQUIREMENTS IF NECESSARY.
	RETURN
1	CONTINUE
	P(N)=RB
	PR(N)=RR
	PL(N)=RL
	PS(N)=STAF
	N=N+1
C PUT AWAY MORE SPACE NEEDS.
	END

	SUBROUTINE JSORT(NO,R2,R4,R5,RN)
	DIMENSION NO(1),RN(1)
	COMMON /RINP/PS(900),PR(300)
C PS HAS 900 SO THERE IS ROOM FOR "NO" ARRAY (CHANGE THIS LATER?)
	COMMON /JST/ N,P(300),PL(300)
	P(N)=R5
	PR(N)=0
	PL(N)=0
	PS(N)=9999.
C LAST POINT IS RIGHT LIMIT OF JUSTIFY AREA
	P(N+1)=9999.
CCC	N=N-1
	K=1
2	A=P(K)
	M=K+1
	KK=K
	DO 1 L=M,N
	B=ABS(P(L)-A)
	IF(B.GT.0.1)GO TO 6
	P(L)=A
C SAME POS.
	GO TO 1
6	IF(P(L).GT.A)GO TO 1
C FIND ITEM FURTHEST TO LEFT
	A=P(L)
	K=L
1	CONTINUE
10	IF(K.EQ.KK)GO TO 3
	B=PR(K)
	C=PL(K)
	D=PS(K)
	DO 4 L=K,KK+1,-1
C SHUFFLE ARRAYS
	LL=L-1
	P(L)=P(LL)
	PL(L)=PL(LL)
	PR(L)=PR(LL)
4	PS(L)=PS(LL)
11	P(KK)=A
	PR(KK)=B
	PL(KK)=C
	PS(KK)=D
3	K=KK+1
	IF(K.LE.N)GO TO 2

C NOW COLLECT ALL SPACE IN PL ARRAY
	DO 20 K=2,N+1
	L=K-1
	IF(PS(K).NE.PS(L))GO TO 21
C SAME STAFF?
	GO TO 23
21	L=K-2
22	IF(PS(L).EQ.PS(K))GO TO 23
	L=L-1
	IF(L.GT.0)GO TO 22
	GO TO 20
23	PL(K)=PL(K)+PR(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
20	CONTINUE

C NOW STORE POS  OF EACH PREV. ITEM ON SAME STAFF IN PR ARRAY.
	DO 40 K=2,N+1
	L=K-1
	IF(PS(K).NE.PS(L))GO TO 41
C SAME STAFF?
	GO TO 43
41	L=K-2
42	IF(PS(L).EQ.PS(K))GO TO 43
	L=L-1
	IF(L.GT.0)GO TO 42
	PR(K)=R4
C FAR LEFT POS. OF JUST. RANGE GOES INTO PS
	GO TO 40
43	PR(K)=P(L)
C FOUND PREVIOUS ITEM ON SAME STAFF.
C STORE POS. OF PREVIOUS ITEM IN PR ARRAY.
40	CONTINUE
	PR(1)=R4

C NOW GET RID OF UNNEEDED DATA
	L=2
30	LL=L-1
	IF(P(L).NE.P(LL))GO TO 36
C NOW 2 ITEMS IN SAME POS. ON DIFF. STAVES
	IF(PR(L).EQ.PR(LL))GO TO 34
C JUMP IF POS. OF PREV. ITEM IS SAME IN BOTH CASES.
	A=P(L)-PR(L)-PL(L)
	B=P(LL)-PR(LL)-PL(LL)
C A,B = EXCESS SPACE AVAILABLE., KEEP THE ONE WITH THE LEAST.
	IF(B.GT.A)L=L-1
	GO TO 35
34	IF(PL(L).GT.PL(LL))PL(LL)=PL(L)
C EXCHANGE IF NEEDED SPACE HERE IS < PREVIOUS NEEDED
35	N=N-1
C DECREMENT COUNTER
33	DO 32 K=L,N
C CONTRACT ARRAY
	M=K+1
	PL(K)=PL(M)
	PR(K)=PR(M)
32	P(K)=P(M)
	GO TO 9
36	L=L+1
9	IF(L.LE.N)GO TO 30
 
100	DO 101 K=1,N
101	PS(K)=P(K)
C PS WILL HOLD SHIFTED POINTS
99	FORMAT('+',I2,1X,$)
98	FORMAT(' ',$)
	TYPE 98
	DO 50 J=1,40
C "ACCORDEAN" LOOP - USUALLY EXITS WELL BEFORE 40
	Y=0
	TYPE 99,J
	DO 51 K=2,N
	A=PS(K)-PR(K)-PL(K)
C NEG. MOVE REQUIREMENT
	IF(A.GE.-0.1)GO TO 51
C SKIP IF ENOUGH SPACE
	Y=PS(K)
C SHIFT ALL POINTS FOUND FROM HERE TO FAR RIGHT
	DO 52 L=K,N
	PS(L)=PS(L)-A
52	IF(PR(L).GE.Y)PR(L)=PR(L)-A
	IF(PR(K).EQ.PS(K-1))GO TO 51
C JUMP IF PREVIOUS ITEM ON SAME STAFF
C NOW SHIFT OTHER STAVES' ITEMS FOUND TO LEFT
	Z=PR(K)
C LOOK IN AREA BOUNDED BY Z AND Y
	F=(Y-Z-A)/(Y-Z)
C SPACING FACTOR
	DO 53 L=1,N
	B=PS(L)
	IF(B.LT.Z.OR.B.GT.Y)GO TO 54
C FOUND A POINT TO SHIFT
	B=B-Z
C ACTUAL SPACE FROM LEFT LIMIT
	PS(L)=Z+B*F
C LEFT LIMIT+SPACE*FACTOR
54	B=PR(L)
	IF(B.LT.Z.OR.B.GT.Y)GO TO 53
	B=B-Z
	PR(L)=Z+B*F
53	CONTINUE
51	CONTINUE
	IF(PS(N).LE.R5)GO TO 203
C MORE THAN ENOUGH SPACE EXISTS
        IF(Y.EQ.0)GO TO 203
C JUMP OUT IF NO POINTS MOVED
      F=(R5-R4)/(PS(N)-R4)
C FACTOR TO SHIFT ALL BACK WITHIN ORIGINAL LIMITS
        DO 56 K=1,N
        PS(K)=R4+(PS(K)-R4)*F
56      PR(K)=R4+(PR(K)-R4)*F
50    CONTINUE

C NOW PS(1) SHOULD BE >=R4, PS(N)<=R5.
203	CALL MOVIT(RN,NO,R5,2000.0,1000.0,0.0)
C MOVE ANYTHING TO RIGHT OF JUSTIFY AREA FAR TO RIGHT.
CC CAN'T USE DO LOOP, FAIL PROG. WIPES OUT AC15.	DO 206 K=1,N
	CALL MOVIT(RN,NO,R4,R5,500.0,0.0)
C NOW MOVE JUSTIFY AREA 500 TO RIGHT. LEAVES ROOM FOR EXPANSION, CONTRACTION.
	K=2
	L=1
C A= AMOUNT MOVED LEFT OR RIGHT.
206	CALL MOVIT(RN,NO,P(L)+500.0,P(K)+500.0,PS(L),PS(K))
C MOVE OLD RANGE INTO NEW RANGE (AND SHIFT BACK 500)
	L=K
	K=K+1
	IF(K.LE.N)GO TO 206
	CALL MOVIT(RN,NO,R5+1000.0,3000.0,-1000.0,0.0)
C MOVE BACK THINGS TO RIGHT OF JUSTIFY AREA.  NOW ALL DONE.
300	END